home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / src / pt-mvr.cc < prev    next >
C/C++ Source or Header  |  1996-11-05  |  7KB  |  378 lines
  1. /*
  2.  
  3. Copyright (C) 1996 John W. Eaton
  4.  
  5. This file is part of Octave.
  6.  
  7. Octave is free software; you can redistribute it and/or modify it
  8. under the terms of the GNU General Public License as published by the
  9. Free Software Foundation; either version 2, or (at your option) any
  10. later version.
  11.  
  12. Octave is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15. for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with Octave; see the file COPYING.  If not, write to the Free
  19. Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  20.  
  21. */
  22.  
  23. #if defined (__GNUG__)
  24. #pragma implementation
  25. #endif
  26.  
  27. #ifdef HAVE_CONFIG_H
  28. #include <config.h>
  29. #endif
  30.  
  31. #include <iostream.h>
  32.  
  33. #include "error.h"
  34. #include "oct-obj.h"
  35. #include "pager.h"
  36. #include "pt-const.h"
  37. #include "pt-exp.h"
  38. #include "pt-fvc.h"
  39. #include "pt-misc.h"
  40. #include "pt-mvr.h"
  41. #include "pt-walk.h"
  42.  
  43. // But first, some extra functions used by the tree classes.
  44.  
  45. // Make sure that all arguments have values.
  46.  
  47. static bool
  48. all_args_defined (const octave_value_list& args)
  49. {
  50.   int nargin = args.length ();
  51.  
  52.   for (int i = 0; i < nargin; i++)
  53.     if (args(i).is_undefined ())
  54.       return false;
  55.  
  56.   return true;
  57. }
  58.  
  59. // Used internally.
  60.  
  61. octave_value
  62. tree_oct_obj::eval (bool /* print */)
  63. {
  64.   return values(0);
  65. }
  66.  
  67. octave_value_list
  68. tree_oct_obj::eval (bool /* print */, int /* nargout */,
  69.             const octave_value_list& /* args */)
  70. {
  71.   return values;
  72. }
  73.  
  74. void
  75. tree_oct_obj::accept (tree_walker& tw)
  76. {
  77.   tw.visit_oct_obj (*this);
  78. }
  79.  
  80. // Index expressions.
  81.  
  82. tree_index_expression::tree_index_expression
  83.   (tree_identifier *i, int l = -1, int c = -1)
  84.     : tree_multi_val_ret (l, c)
  85.       {
  86.     id = new tree_indirect_ref (i);
  87.     list = 0;
  88.       }
  89.  
  90. tree_index_expression::tree_index_expression
  91.   (tree_identifier *i, tree_argument_list *lst, int l = -1, int c = -1)
  92.     : tree_multi_val_ret (l, c)
  93.       {
  94.     id = new tree_indirect_ref (i);
  95.     list = lst;
  96.       }
  97.  
  98. tree_index_expression::~tree_index_expression (void)
  99. {
  100.   delete id;
  101.   delete list;
  102. }
  103.  
  104. string
  105. tree_index_expression::name (void)
  106. {
  107.   return id->name ();
  108. }
  109.  
  110. void
  111. tree_index_expression::mark_for_possible_ans_assign (void)
  112. {
  113.   if (id)
  114.     id->mark_for_possible_ans_assign ();
  115. }
  116.  
  117. octave_value
  118. tree_index_expression::eval (bool print)
  119. {
  120.   octave_value retval;
  121.  
  122.   if (error_state)
  123.     return retval;
  124.  
  125.   if (list)
  126.     {
  127.       // Extract the arguments into a simple vector.  Don't pass null
  128.       // args.
  129.  
  130.       octave_value_list args = list->convert_to_const_vector ();
  131.  
  132.       if (error_state)
  133.     eval_error ();
  134.       else
  135.     {
  136.       if (error_state)
  137.         eval_error ();
  138.       else
  139.         {
  140.           if (all_args_defined (args))
  141.         {
  142.           octave_value_list tmp = id->eval (print, 1, args);
  143.  
  144.           if (error_state)
  145.             eval_error ();
  146.           else if (tmp.length () > 0)
  147.             retval = tmp(0);
  148.         }
  149.           else
  150.         {
  151.           ::error ("undefined arguments found in index expression");
  152.           eval_error ();
  153.         }
  154.         }
  155.     }
  156.     }
  157.   else
  158.     {
  159.       retval = id->eval (print);
  160.  
  161.       if (error_state)
  162.     eval_error ();
  163.     }
  164.  
  165.   return retval;
  166. }
  167.  
  168. octave_value_list
  169. tree_index_expression::eval (bool print, int nargout,
  170.                  const octave_value_list& /* args */)
  171. {
  172.   octave_value_list retval;
  173.  
  174.   if (error_state)
  175.     return retval;
  176.  
  177.   if (list)
  178.     {
  179.       // Extract the arguments into a simple vector.  Don't pass null
  180.       // args.
  181.  
  182.       octave_value_list tmp_args = list->convert_to_const_vector ();
  183.  
  184.       if (error_state)
  185.     eval_error ();
  186.       else
  187.     {
  188.       if (error_state)
  189.         eval_error ();
  190.       else
  191.         {
  192.           if (all_args_defined (tmp_args))
  193.         {
  194.           retval = id->eval (print, nargout, tmp_args);
  195.  
  196.           if (error_state)
  197.             eval_error ();
  198.         }
  199.           else
  200.         {
  201.           ::error ("undefined arguments found in index expression");
  202.           eval_error ();
  203.         }
  204.         }
  205.     }
  206.     }
  207.   else
  208.     {
  209.       octave_value_list tmp_args;
  210.  
  211.       retval = id->eval (print, nargout, tmp_args);
  212.  
  213.       if (error_state)
  214.     eval_error ();
  215.     }
  216.  
  217.   return retval;
  218. }
  219.  
  220. void
  221. tree_index_expression::eval_error (void)
  222. {
  223.   if (error_state > 0)
  224.     {
  225.       int l = line ();
  226.       int c = column ();
  227.       char *fmt;
  228.       if (l != -1 && c != -1)
  229.     {
  230.       if (list)
  231.         fmt = "evaluating index expression near line %d, column %d";
  232.       else
  233.         fmt = "evaluating expression near line %d, column %d";
  234.  
  235.       ::error (fmt, l, c);
  236.     }
  237.       else
  238.     {
  239.       if (list)
  240.         ::error ("evaluating index expression");
  241.       else
  242.         ::error ("evaluating expression");
  243.     }
  244.     }
  245. }
  246.  
  247. void
  248. tree_index_expression::accept (tree_walker& tw)
  249. {
  250.   tw.visit_index_expression (*this);
  251. }
  252.  
  253. // Multi-valued assignmnt expressions.
  254.  
  255. tree_multi_assignment_expression::~tree_multi_assignment_expression (void)
  256. {
  257.   if (! preserve)
  258.     delete lhs;
  259.  
  260.   delete rhs;
  261. }
  262.  
  263. octave_value
  264. tree_multi_assignment_expression::eval (bool print)
  265. {
  266.   octave_value retval;
  267.  
  268.   if (error_state)
  269.     return retval;
  270.  
  271.   octave_value_list tmp_args;
  272.   octave_value_list result = eval (print, 1, tmp_args);
  273.  
  274.   if (result.length () > 0)
  275.     retval = result(0);
  276.  
  277.   return retval;
  278. }
  279.  
  280. octave_value_list
  281. tree_multi_assignment_expression::eval (bool print, int nargout,
  282.                     const octave_value_list& /* args */)
  283. {
  284.   assert (etype == tree_expression::multi_assignment);
  285.  
  286.   if (error_state || ! rhs)
  287.     return octave_value_list ();
  288.  
  289.   nargout = lhs->length ();
  290.   octave_value_list tmp_args;
  291.   octave_value_list results = rhs->eval (0, nargout, tmp_args);
  292.  
  293.   if (error_state)
  294.     eval_error ();
  295.  
  296.   int ma_line = line ();
  297.   int ma_column = column ();
  298.  
  299.   if (results.length () > 0)
  300.     {
  301.       int i = 0;
  302.  
  303.       bool pad_after = false;
  304.  
  305.       for (Pix p = lhs->first (); p != 0; lhs->next (p))
  306.     {
  307.       tree_index_expression *lhs_expr = lhs->operator () (p);
  308.  
  309.       if (i < nargout)
  310.         {
  311.           // XXX FIXME? XXX -- this is apparently the way Matlab
  312.           // works, but maybe we should have the option of
  313.           // skipping the assignment instead.
  314.  
  315.           tree_constant *tmp = 0;
  316.           if (results(i).is_undefined ())
  317.         {
  318.           error ("element number %d undefined in return list", i+1);
  319.           eval_error ();
  320.           break;
  321.         }
  322.           else
  323.         tmp = new tree_constant (results(i));
  324.  
  325.           tree_simple_assignment_expression tmp_expr
  326.         (lhs_expr, tmp, 1, 0, ma_line, ma_column);
  327.  
  328.           results(i) = tmp_expr.eval (false); // May change
  329.  
  330.           if (error_state)
  331.         break;
  332.  
  333.           if (print && pad_after)
  334.         octave_stdout << "\n";
  335.  
  336.           if (print)
  337.         results(i).print_with_name (lhs_expr->name (), 0);
  338.  
  339.           pad_after = true;
  340.  
  341.           i++;
  342.         }
  343.       else
  344.         {
  345.           tree_simple_assignment_expression tmp_expr
  346.         (lhs_expr, 0, 1, 0, ma_line, ma_column);
  347.  
  348.           tmp_expr.eval (false);
  349.         }
  350.     }
  351.  
  352.       if (print && pad_after)
  353.     octave_stdout << "\n";
  354.     }
  355.  
  356.   return results;
  357. }
  358.  
  359. void
  360. tree_multi_assignment_expression::eval_error (void)
  361. {
  362.   if (error_state > 0)
  363.     ::error ("evaluating assignment expression near line %d, column %d",
  364.          line (), column ());
  365. }
  366.  
  367. void
  368. tree_multi_assignment_expression::accept (tree_walker& tw)
  369. {
  370.   tw.visit_multi_assignment_expression (*this);
  371. }
  372.  
  373. /*
  374. ;;; Local Variables: ***
  375. ;;; mode: C++ ***
  376. ;;; End: ***
  377. */
  378.